#lang racket


(require "../backends/main.rkt"
         "../base/main.rkt"
         "../proxies/main.rkt")

(require (prefix-in met: "ogl-methods.rkt"))

(provide opengl-backend%)


(define opengl-proxy%
  (class* generic-proxy% ()
    (super-new)
    
    (met:load-opengl-methods)
    
    (define-impl-methods
      ; shapes
      
      ; points
      ((point c) met:point)
      
      ; lines
      ;    (define/override (arc angle radius) (met:arc angle radius))
      ;    (define/override (elliptical-arc angle x-radius y-radius) (met:elliptical-arc angle x-radius y-radius))
      ;    (define/override (ellipse x-radius y-radius) (met:ellipse x-radius y-radius))
      ;    (define/override (line closed? coords) (met:line closed? coords))
      ;    (define/override (spline closed? cs type) (met:spline closed? cs type))
      
      ;    (define/override (line? shape) (met:line? shape))
      ;    (define/override (line-closed? shape) (met:line-closed? shape))
      ;    
      ;    (define/override (line-begin-c shape) (met:line-begin-c shape))
      ;    (define/override (line-end-c shape) (met:line-end-c shape))
      
      ; surfaces
      ;    (define/override (ngon width sides) (met:ngon (surface-primitive-type) width sides))
      ;    (define/override (surface shapes) (met:surface shapes))
      ;    
      ;    (define/override (surface? shape) (met:surface? shape))
      ;    
      ;    (define/override (surface-curvature shape) (met:surface-curvature shape))
      ;    (define/override (surface-domain shape) (met:surface-domain shape))
      
      ; solids
      ((box width length height) met:box)
      ((cone radius height) met:cone)
      ((cone-frustum base-radius top-radius height) met:cone-frustum)
      ((cylinder radius height) met:cylinder)
      
      ;(define/override (pyramid width sides height) (met:pyramid width sides height))
      
      ((sphere radius) met:sphere)
      
      ;    (define/override (solid? shape) (met:solid? shape))
      
      ; generic shapes
      ;    (define/override (circle type radius) (met:circle type radius))
      ;    (define/override (rectangle type width length) (met:rectangle type width length))
      
      ; text
      
      ; transformations
      ;    (define/override (extrude length dir shape) (met:extrude length dir shape))
      ((intersect ids) met:intersect)
      ;    (define/override (join shapes) (met:join shapes))
      ;    (define/override (loft loft-type loft-fit-type closed? shapes) (met:loft loft-type loft-fit-type closed? shapes))
      ((move position shape) met:move)
      ((rotate angle normal shape) met:rotate)
      ((scale type c shape/shapes) met:scale)
      ;    (define/override (section type plane shape) (met:section type plane shape))
      ;    (define/override (slice shape1 shape2) (met:slice shape1 shape2))
      ;    (define/override (subtract shapes) (met:subtract shapes))
      ;    (define/override (thicken distance shape) (thicken distance shape))
      ;    (define/override (union shapes) (met:union shapes))
      
      ; lang
      ;    (define/override (par shape) (met:par shape))
      
      ; cad
      ;    (define/override (clone-shape shape) (met:clone-shape shape))
      ;    (define/override (clone-shapes shapes) (met:clone-shapes shapes))
      ;    (define/override (delete-shape shape) (met:delete-shape shape))
      ((delete-shapes) met:delete-shapes)
      ;    (define/override (get-shapes) (met:get-shapes))
      ;    (define/override (layer name shape/shapes) shape/shapes)
      ;    (define/override (prompt-point message) (met:prompt-point message))
      ;    (define/override (prompt-shape message) (met:prompt-shape message))
      ;    (define/override (render-shapes width height path type) (met:render-shapes width height path type))
      ;    (define/override (select-shape shape) (met:select-shape shape))
      ;    (define/override (select-shapes shapes) (met:select-shapes shapes))
      ;    (define/override (view type projection-type style shape/shapes) (met:view type projection-type style shape/shapes))))
      )))

(define opengl-backend%
  (class* proxy-backend% ()
    (let* ((proxy (new opengl-proxy%))
           (evaluator (new evaluator-visitor% (backend this))))
      (super-new (proxy proxy) (evaluator evaluator)))
    
    ; evaluate
    
    ; edit: possible optimization: do not invoke 'enable-redraw' unless absolutely necessary
    (define/override (evaluate-toplevel expr)
      (met:enable-redraw #f)
      (finally
       (super evaluate-toplevel expr)
       (λ () (met:enable-redraw #t))))))